home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / tgeni386.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  20KB  |  653 lines
  1. {
  2.     $Id: tgeni386.pas,v 1.1.1.1 1998/03/25 11:18:15 root Exp $
  3.     Copyright (C) 1993-98 by Florian Klaempfl
  4.  
  5.     This unit handles the temporary variables stuff for i386
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. unit tgeni386;
  24.  
  25.   interface
  26.  
  27.     uses
  28.        cobjects,globals,tree,hcodegen,verbose,files,aasm
  29. {$ifdef i386}
  30.        ,i386
  31. {$endif}
  32.        ;
  33.  
  34.     type
  35.        tregisterset = set of tregister;
  36.  
  37.        tpushed = array[R_EAX..R_MM6] of boolean;
  38.  
  39.     const
  40.        usablereg32 : byte = 4;
  41. {$ifdef SUPPORT_MMX}
  42.        usableregmmx : byte = 8;
  43. {$endif SUPPORT_MMX}
  44.  
  45.     function getregister32 : tregister;
  46.     procedure ungetregister32(r : tregister);
  47. {$ifdef SUPPORT_MMX}
  48.     function getregistermmx : tregister;
  49.     procedure ungetregistermmx(r : tregister);
  50. {$endif SUPPORT_MMX}
  51.  
  52.     procedure ungetregister(r : tregister);
  53.  
  54.     procedure cleartempgen;
  55.  
  56.     { generates temporary variables }
  57.     procedure resettempgen;
  58.     procedure setfirsttemp(l : longint);
  59.     function gettempsize : longint;
  60.     function gettempofsize(size : longint) : longint;
  61.     procedure gettempofsizereference(l : longint;var ref : treference);
  62.     function istemp(const ref : treference) : boolean;
  63.     procedure ungetiftemp(const ref : treference);
  64.  
  65.     procedure del_reference(const ref : treference);
  66.     procedure del_locref(const location : tlocation);
  67.  
  68.  
  69.     { pushs and restores registers }
  70.     procedure pushusedregisters(var pushed : tpushed;b : byte);
  71.     procedure popusedregisters(const pushed : tpushed);
  72.  
  73.     var
  74.        unused,usableregs : tregisterset;
  75.        c_usableregs : longint;
  76.  
  77.        { uses only 1 byte while a set uses in FPC 32 bytes }
  78.        usedinproc : byte;
  79.  
  80.        { count, how much a register must be pushed if it is used as register }
  81.        { variable                                                            }
  82. {$ifdef SUPPORT_MMX}
  83.        reg_pushes : array[R_EAX..R_MM6] of longint;
  84.        is_reg_var : array[R_EAX..R_MM6] of boolean;
  85. {$else SUPPORT_MMX}
  86.        reg_pushes : array[R_EAX..R_EDI] of longint;
  87.        is_reg_var : array[R_EAX..R_EDI] of boolean;
  88. {$endif SUPPORT_MMX}
  89.   implementation
  90.  
  91.     procedure pushusedregisters(var pushed : tpushed;b : byte);
  92.  
  93.       var
  94.          r : tregister;
  95.          hr : preference;
  96.  
  97.       begin
  98.          usedinproc:=usedinproc or b;
  99.          for r:=R_EAX to R_EBX do
  100.            begin
  101.               pushed[r]:=false;
  102.               { if the register is used by the calling subroutine    }
  103.               if ((b and ($80 shr byte(r)))<>0) then
  104.                 begin
  105.                    { and is present in use }
  106.                    if not(r in unused) then
  107.                      begin
  108.                         { then save it }
  109.                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r)));
  110.                         { here was a big problem  !!!!!}
  111.                         { you cannot do that for a register that is
  112.                         globally assigned to a var
  113.                         this also means that you must push it much more
  114.                         often, but there must be a better way
  115.                         maybe by putting the value back to the stack !! }
  116.                         if not(is_reg_var[r]) then
  117.                           unused:=unused+[r];
  118.                         pushed[r]:=true;
  119.                      end;
  120.                 end;
  121.            end;
  122. {$ifdef SUPPORT_MMX}
  123.          for r:=R_MM0 to R_MM6 do
  124.            begin
  125.               pushed[r]:=false;
  126.               { if the mmx register is in use, save it }
  127.               if not(r in unused) then
  128.                 begin
  129.                    exprasmlist^.concat(new(pai386,op_const_reg(
  130.                      A_SUB,S_L,8,R_ESP)));
  131.                    new(hr);
  132.                    reset_reference(hr^);
  133.                    hr^.base:=R_ESP;
  134.                    exprasmlist^.concat(new(pai386,op_reg_ref(
  135.                      A_MOVQ,S_NO,r,hr)));
  136.                    if not(is_reg_var[r]) then
  137.                      unused:=unused+[r];
  138.                    pushed[r]:=true;
  139.                 end;
  140.            end;
  141. {$endif SUPPORT_MMX}
  142.       end;
  143.  
  144.     procedure popusedregisters(const pushed : tpushed);
  145.  
  146.       var
  147.          r : tregister;
  148.          hr : preference;
  149.  
  150.       begin
  151.          { restore in reverse order: }
  152. {$ifdef SUPPORT_MMX}
  153.          for r:=R_MM6 downto R_MM0 do
  154.            begin
  155.               if pushed[r] then
  156.                 begin
  157.                    new(hr);
  158.                    reset_reference(hr^);
  159.                    hr^.base:=R_ESP;
  160.                    exprasmlist^.concat(new(pai386,op_ref_reg(
  161.                      A_MOVQ,S_NO,hr,r)));
  162.                    exprasmlist^.concat(new(pai386,op_const_reg(
  163.                      A_ADD,S_L,8,R_ESP)));
  164.                    unused:=unused-[r];
  165.                 end;
  166.            end;
  167. {$endif SUPPORT_MMX}
  168.          for r:=R_EBX downto R_EAX do
  169.            if pushed[r] then
  170.              begin
  171.                 exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,r)));
  172.                 unused:=unused-[r];
  173.              end;
  174.       end;
  175.  
  176.     procedure ungetregister(r : tregister);
  177.  
  178.       begin
  179.          if r in [R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI] then
  180.            ungetregister32(r)
  181.          else if r in [R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI] then
  182.            ungetregister32(reg16toreg32(r))
  183.          else if r in [R_AL,R_BL,R_CL,R_DL] then
  184.            ungetregister32(reg8toreg32(r))
  185. {$ifdef SUPPORT_MMX}
  186.          else if r in [R_MM0..R_MM6] then
  187.            ungetregistermmx(r)
  188. {$endif SUPPORT_MMX}
  189.          else internalerror(18);
  190.       end;
  191.  
  192.     procedure ungetregister32(r : tregister);
  193.  
  194.       begin
  195.          if cs_maxoptimieren in aktswitches then
  196.            begin
  197.               { takes much time }
  198.               if not(r in usableregs) then
  199.                 exit;
  200.               unused:=unused+[r];
  201.               inc(usablereg32);
  202.            end
  203.          else
  204.            begin
  205.               if not(r in [R_EAX,R_EBX,R_ECX,R_EDX]) then
  206.                 exit;
  207.               unused:=unused+[r];
  208.               inc(usablereg32);
  209.            end;
  210.       end;
  211.  
  212. {$ifdef SUPPORT_MMX}
  213.     function getregistermmx : tregister;
  214.  
  215.       var
  216.          r : tregister;
  217.  
  218.       begin
  219.          dec(usableregmmx);
  220.          for r:=R_MM0 to R_MM6 do
  221.            if r in unused then
  222.              begin
  223.                 unused:=unused-[r];
  224.                 usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  225.                 getregistermmx:=r;
  226.                 exit;
  227.              end;
  228.          internalerror(10);
  229.       end;
  230.  
  231.     procedure ungetregistermmx(r : tregister);
  232.  
  233.       begin
  234.          if cs_maxoptimieren in aktswitches then
  235.            begin
  236.               { takes much time }
  237.               if not(r in usableregs) then
  238.                 exit;
  239.               unused:=unused+[r];
  240.               inc(usableregmmx);
  241.            end
  242.          else
  243.            begin
  244.               unused:=unused+[r];
  245.               inc(usableregmmx);
  246.            end;
  247.       end;
  248. {$endif SUPPORT_MMX}
  249.  
  250.     procedure del_reference(const ref : treference);
  251.  
  252.       begin
  253.          if ref.isintvalue then
  254.            exit;
  255.          ungetregister32(ref.base);
  256.          ungetregister32(ref.index);
  257.          { ref.segment:=R_DEFAULT_SEG; }
  258.       end;
  259.  
  260.     procedure del_locref(const location : tlocation);
  261.  
  262.       begin
  263.          if (location.loc<>loc_mem) and (location.loc<>loc_reference) then
  264.            exit;
  265.          if location.reference.isintvalue then
  266.            exit;
  267.          ungetregister32(location.reference.ba